home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / nasa / co_trans / co_trans.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-02  |  7.3 KB  |  254 lines
  1. program co_trans; { Koordinatentransformation }
  2.  
  3. const
  4.    {$I b:math_con }
  5.  
  6.    OBLIQUITY = 0.4092062; { Schiefe der Ekliptik }
  7.  
  8. type
  9.    ZEIT = record
  10.              stunde:0..23;
  11.              minute,sekunde:0..59;
  12.           end;
  13.  
  14.    DATUM = record
  15.               jahr:integer;
  16.               monat:1..12;
  17.               tag:1..31;
  18.            end;
  19.  
  20.    JUL = record
  21.             ganz:long_integer;
  22.             fract:real;
  23.          end;
  24.  
  25. var c:char;
  26.  
  27.    {$I b:math_sub }
  28.  
  29. procedure juldat(var julian:JUL; gregorian:DATUM; uhrzeit:ZEIT;
  30.                  flag:boolean);
  31. external;
  32.  
  33. procedure sidtime(var sternzeit:ZEIT; julian:JUL);
  34. external;
  35.  
  36. procedure etoa(var ra,de:real; l,b,obl:real);
  37. external;
  38.  
  39. procedure atoe(var l,b:real; ra,de,obl:real);
  40. external;
  41.  
  42. procedure htoa(var ra,de:real; az,h,phi:real);
  43. external;
  44.  
  45. procedure atoh(var az,h:real; ra,de,phi:real);
  46. external;
  47.  
  48. procedure ttog(var ra,de,r:real; rat,det,rt,rab,deb:real);
  49. external;
  50.  
  51. procedure gtot(var rat,det,rt:real; ra,de,r,rab,deb:real);
  52. external;
  53.  
  54. procedure time(var uhr:ZEIT; winkel:real);
  55. begin
  56.    winkel := deg(winkel) / 15.0;
  57.    uhr.stunde := trunc(winkel); winkel := winkel - uhr.stunde;
  58.    winkel := winkel * 60.0;
  59.    uhr.minute := trunc(winkel); winkel := winkel - uhr.minute;
  60.    winkel := winkel * 60.0;
  61.    uhr.sekunde := trunc(winkel)
  62. end;
  63.  
  64. { ekliptikal -> aequatorial }
  65. procedure ea;
  66. var ra,de,l,b:real;
  67.     rat:ZEIT;
  68.     c:char;
  69. begin
  70.    write(chr(27),'E');
  71.    writeln('< CONVERT ECLIPTICAL COORDINATES INTO EQUATORIAL COORDINATES >');
  72.    writeln;
  73.    write('> Ecliptical longitude: '); readln(l);
  74.    write('> Ecliptical latitude : '); readln(b);
  75.    writeln;
  76.    etoa(ra,de,rad(l),rad(b),OBLIQUITY);
  77.    time(rat, ra);
  78.    writeln('  Right ascension: ',rat.stunde:2,rat.minute:3,rat.sekunde:3);
  79.    writeln('  Declination    : ',deg(de):10:5);
  80.    read(c)
  81. end;
  82.  
  83. { aequatorial -> ekliptikal }
  84. procedure ae;
  85. var ra,de,l,b:real;
  86.     rat:ZEIT;
  87.     c:char;
  88. begin
  89.    write(chr(27),'E');
  90.    writeln('< CONVERT EQUATORIAL COORDINATES INTO ECLIPTICAL COORDINATES >');
  91.    writeln;
  92.    write('> Right ascension: hour  : '); readln(rat.stunde);
  93.    write('>                  minute: '); readln(rat.minute);
  94.    write('>                  second: '); readln(rat.sekunde);
  95.    write('> Declination    : '); readln(de);
  96.    writeln;
  97.    ra := 15.0 * (rat.stunde + rat.minute / 60.0 + rat.sekunde / 3600.0);
  98.    atoe(l,b,rad(ra),rad(de),OBLIQUITY);
  99.    writeln('  Ecliptical longitude: ',deg(l):10:5);
  100.    writeln('  Ecliptical latitude : ',deg(b):10:5);
  101.    readln(c)
  102. end;
  103.  
  104. { Geographische Daten eingeben }
  105. procedure geoin(var lmst,phi:real);
  106. var flag:boolean;
  107.     l:real;
  108.     ut:ZEIT;
  109.     date:DATUM;
  110.     jd:JUL;
  111.     c:char;
  112. begin
  113.    write('> Date: year : '); readln(date.jahr);
  114.    write('>       month: '); readln(date.monat);
  115.    write('>       day  : '); readln(date.tag);
  116.    write('> UT:  hour  : '); readln(ut.stunde);
  117.    write('>      minute: '); readln(ut.minute);
  118.    write('>      second: '); readln(ut.sekunde);
  119.    write('> Gregorian calendar (y/n): '); read(c);
  120.    writeln;
  121.    if c = 'n' then flag := false else flag := true;
  122.    write('> Longitude: '); readln(l);
  123.    write('> Latitude : '); readln(phi);
  124.    juldat(jd,date,ut,flag);
  125.    sidtime(ut,jd);
  126.    lmst := 15.0 * (ut.stunde + ut.minute / 60.0 + ut.stunde / 3600.0) - l
  127. end;
  128.  
  129. { aequatorial -> horizontal }
  130. procedure ah;
  131. var de,lmst,t,phi,h,az:real;
  132.     ra:ZEIT;
  133.     c:char;
  134. begin
  135.    write(chr(27),'E');
  136.    writeln('< CONVERT EQUATORIAL COORDINATES INTO HORIZONTAL COORDINATES >');
  137.    writeln;
  138.    geoin(lmst,phi);
  139.    write('> Right ascension: hour  : '); readln(ra.stunde);
  140.    write('>                  minute: '); readln(ra.minute);
  141.    write('>                  second: '); readln(ra.sekunde);
  142.    write('> Declination    : '); readln(de);
  143.    writeln;
  144.    t := lmst - (ra.stunde + ra.minute / 60.0 + ra.sekunde / 3600.0) * 15.0;
  145.    t := pi2mod(rad(t));
  146.    atoh(az,h,t,rad(de),rad(phi));
  147.    writeln('  Azimut: ',deg(az):10:5);
  148.    writeln('  Height: ',deg(h):10:5);
  149.    read(c)
  150. end;
  151.  
  152. { horizontal -> aequatorial }
  153. procedure ha;
  154. var de,lmst,t,phi,h,az:real;
  155.     ra:ZEIT;
  156.     c:char;
  157. begin
  158.    write(chr(27),'E');
  159.    writeln('< CONVERT HORIZONTAL COORDINATES INTO EQUATORIAL COORDINATES >');
  160.    writeln;
  161.    geoin(lmst,phi);
  162.    write('> Azimut: '); readln(az);
  163.    write('> Height: '); readln(h);
  164.    writeln;
  165.    htoa(t,de,rad(az),rad(h),rad(phi));
  166.    t := pi2mod(rad(lmst) - t);
  167.    time(ra,t);
  168.    writeln('  Right ascension: ',ra.stunde:2,ra.minute:3, ra.sekunde:3);
  169.    writeln('  Declination    : ',deg(de):10:5);
  170.    read(c)
  171. end;
  172.  
  173. { topographisch -> geozentrisch }
  174. procedure tg;
  175. var ra,dego,rg,rat1,det,rt,lmst,phi:real;
  176.     rat,rag:ZEIT;
  177.     c:char;
  178. begin
  179.    write(chr(27),'E');
  180.    writeln('< CONVERT TOPOCENTRIC EQUTORIAL INTO GEOCENTRIC EQUATORIAL >');
  181.    writeln;
  182.    geoin(lmst,phi);
  183.    write('> Right ascension:   hour: '); readln(rat.stunde);
  184.    write('>                  minute: '); readln(rat.minute);
  185.    write('>                  second: '); readln(rat.sekunde);
  186.    write('> Declination    : '); readln(det);
  187.    write('> Distance AU    : '); readln(rt);
  188.    writeln;
  189.    rat1 := 15 * (rat.stunde + rat.minute * 60.0 + rat.sekunde * 3600.0);
  190.    ttog(ra,dego,rg,rad(rat1),rad(det),rt,rad(lmst),rad(phi));
  191.    time(rag,ra);
  192.    writeln('Geocentric coordinates:');
  193.    writeln('  Right ascension: ',rag.stunde:2,rag.minute:3,rag.sekunde:3);
  194.    writeln('  Declination    : ',deg(dego):10:5);
  195.    writeln('  Distance       : ',rg);
  196.    read(c)
  197. end;
  198.  
  199. { geozentrisch -> topozentrisch }
  200. procedure gt;
  201. var ra,dego,rg,rat1,det,rt,lmst,phi:real;
  202.     rat,rag:ZEIT;
  203.     c:char;
  204. begin
  205.    write(chr(27),'E');
  206.    writeln('< CONVERT GEOCENTRIC EQUTORIAL INTO TOPOCENTRIC EQUATORIAL >');
  207.    writeln;
  208.    geoin(lmst,phi);
  209.    write('> Right ascension:   hour: '); readln(rag.stunde);
  210.    write('>                  minute: '); readln(rag.minute);
  211.    write('>                  second: '); readln(rag.sekunde);
  212.    write('> Declination    : '); readln(dego);
  213.    write('> Distance AU    : '); readln(rg);
  214.    writeln;
  215.    ra := 15 * (rag.stunde + rag.minute * 60.0 + rag.sekunde * 3600.0);
  216.    gtot(rat1,det,rt,rad(ra),rad(dego),rg,rad(lmst),rad(phi));
  217.    time(rat,rat1);
  218.    writeln('Topocentric coordinates:');
  219.    writeln('  Right ascension: ',rat.stunde:2,rat.minute:3,rat.sekunde:3);
  220.    writeln('  Declination    : ',deg(det):10:5);
  221.    writeln('  Distance       : ',rt);
  222.    read(c)
  223. end;
  224.  
  225. begin
  226.    repeat
  227.       write(chr(27),'E');
  228.       writeln('< CONVERSION BETWEEN DIFFERENT COORDINATE-SYSTEMS >');
  229.       writeln;
  230.       writeln('  select conversion:');
  231.       writeln;
  232.       writeln('  a) ecliptical             --> geozentric equatorial');
  233.       writeln('  b) geozentric equatorial  --> ecliptical');
  234.       writeln;
  235.       writeln('  c) horizontal             --> topozentric equatorial');
  236.       writeln('  d) topozentric equatorial --> horizontal');
  237.       writeln;
  238.       writeln('  e) geozentric equatorial  --> topozentric equatorial');
  239.       writeln('  f) topozentric equatorial --> geozentric equatorial');
  240.       writeln;
  241.       writeln('  x) exit');
  242.       read(c);
  243.       case c of
  244.          'a':ea;
  245.          'b':ae;
  246.          'c':ha;
  247.          'd':ah;
  248.          'e':gt;
  249.          'f':tg;
  250.       end;
  251.    until c = 'x';
  252.    writeln
  253. end.
  254.